#!/usr/bin/env perl

use warnings;
use strict;
use LWP::Simple;
use Getopt::Long;
use File::Temp qw/ tempfile tempdir /;
use Cwd;
use Data::Dumper;
use File::Copy::Recursive qw(rcopy);
use File::Path;
use Config::Auto;

#FIXME:
# change to global usage of config
# able to update form milestone in cache
# remove dependency on File::Temp, File::Copy::Recursive

############################ Constants
my $DEBUG_LOG_LEVEL= 3;
my $NORMAL_LOG_LEVEL= 2;
my $QUIET_LOG_LEVEL= 0;

############################ Globals
my $log_level= $NORMAL_LOG_LEVEL;

############################ Prototypes
sub merge_defaults($$);     #works
sub milestone_in_cache($$); #works 
sub ensure_cache_dir($);    #works
sub cache_touch($$);        #works
sub cache_evict($);         #works
sub cache_add_from_checkout($$$);
sub run;                    #works
sub interpret_branch($$);
sub is_milestone($);        #works (copied)
sub cached_get($);
sub latest_milestone($);    
sub grab_tag_list();        #works (copied)
sub update_to($$$);
sub ensure_workdir();        #works
sub untar_milestone($$);  
sub download_from_go_oo($$); #works
sub logger;                  #works

############################ Subs			  
sub merge_defaults($$)
{
    my $defaults= shift;
    my $config= shift;
    
    while ((my $key, my $value) = each %$defaults)
    {
	$config->{$key} = $value unless exists $config->{$key};
    }
}

sub milestone_in_cache($$)
{
    my $config= shift;
    my $milestone= shift;
    my $dir= $config->{'cache_dir'};

    opendir(DIR, $dir) || die "can't opendir $dir: $!";
    my @entries= readdir(DIR);
    closedir(DIR);
    foreach (@entries)
    {
	if (/$milestone\.tar\.bz2/)
	{
	    logger "$milestone is a cache hit";
	    return 1;
	}
    }
    return 0;
}

sub ensure_cache_dir($)
{
    my $config= shift;
    unless (-d $config->{'cache_dir'})
    {
	mkdir $config->{'cache_dir'};
    }
}

sub cache_touch($$)
{
    my $config= shift;
    my $milestone= shift;
    my $filename= $config->{'cache_dir'} . "$milestone.tar.bz2";
    die "can't write to: $filename!!" unless -w $filename;
    system("touch", $filename);
}

sub cache_evict($)
{
    my $config= shift;
    my $dir= $config->{'cache_dir'};
    opendir(DIR, $dir) || die "can't opendir $dir: $!";
    my @entries= readdir(DIR);
    closedir(DIR);
    my %meta;
    foreach my $file (@entries)
    {
	if ($file =~ /\.tar\.bz2/)
	{
	    my @stat_values= stat $dir . $file;
	    $meta{$file}= $stat_values[9];
	}
    }
    logger "Cache data: " . Dumper(\%meta), $DEBUG_LOG_LEVEL;
    if ((keys %meta) == $config->{'cache_size'})
    {
	my $evictee = (sort { $meta{$a} <=> $meta{$b} } keys %meta)[0];
	logger "evicting $evictee from cache";
	unlink $dir . $evictee;
    }
}

sub cache_add_from_checkout($$$)
{
    my $config= shift;
    my $milestone= shift;
    my $vcs= shift;

    my $cwd = &Cwd::cwd();
    chdir('workdir');
    logger "grabbing $milestone from $vcs";
    if ( $vcs eq "cvs" )
    {
        run('cvs', '-d', $config->{'cvs_root'}, 
	        $config->{'cvs_options'}, 'co', '-r', $milestone, 'OpenOffice2');
    }
    elsif ( $vcs eq "svn" )
    {
        run('svn', 'checkout', $config->{'svn_root'}."/tags/$milestone",
            $config->{'svn_options'} );
    }
    my @files= glob '*';
    logger "tarballing $milestone for cache...";
    run('tar', 'cjf', $config->{'cache_dir'} . "$milestone.tar.bz2", @files);
    logger "done!";
    chdir $cwd;
}

# Runs a command via system(), prints a result to logger and returns
# the exit code of the command after its execution.
sub run
{
    logger "system(\"" . join ('", "', @_) . "\");\n", $DEBUG_LOG_LEVEL;

    my $resultcode = system(@_);
    if($resultcode != 0)
    {
        die "can't run $_[0]!!\n";
    }
    else
    {
        return $resultcode;
    }
}

sub interpret_branch($$)
{
    my $name= shift;
    my $cws_list= shift;
    my $milestone;
    my $cws= "none"; #special case

    if ($name eq 'HEAD' || $name eq '')
    {
        $milestone= latest_milestone('DEV310');
        if ( !$milestone )
        {
            $milestone= latest_milestone('DEV300');
        }
        die "couldn't find latest milestone!\n" unless $milestone;
    }
    elsif(is_milestone($name))
    {
        $milestone= $name;
    }
    else
    {
        die "cws not found!!\n" unless $cws_list->{$name};
        $cws= $name;
        $milestone= $cws_list->{$name}->{'base'};
    }
    return ($milestone, $cws);
}

sub cached_get($)
{
    my $url = shift;
    my $filename = $url;
    my $fetchfailed = 0;

    $filename =~ s/.*\///;
    my $response_ = get($url) || { $fetchfailed = 1 };
    #my $response_ = "" ; $fetchfailed = 1;

    if ( $fetchfailed )
    {
        print "Couldn't get $url\ reading from file $filename\n";
        open CACHEX, "< $filename" || die "error opening file $filename\n";
        $response_ = join( "", <CACHEX> ) || die "error reading file $filename\n";
        close CACHEX;
    }
    else
    {
        open CACHEX, ">$filename";
        print CACHEX $response_;
        close CACHEX;
    }

    return $response_;
}

sub grab_tag_list()
{
    my $url= 'http://go-oo.org/tinderbox/tags/tag-list';
    
    my $response = cached_get($url);

    my %h;
    foreach(split /\n/, $response)
    {
	unless (/\#.*/)
	{
            my $dirs = '';
            my $newdirs = '';
	    (my $name, my $base, my $tag, $dirs, $newdirs) = split / : /, $_;
	    
	    $h{$name}= 
	    {
		'base' => $base,
		'tag'  => $tag,
		'dirs' => [split / /, $dirs],
		'newdirs' => [split / /, $newdirs]
		};
	}
    }
    return \%h;
}

sub latest_milestone($)
{
    my $master= shift;
    my $url = 'http://go-oo.org/tinderbox/tags/tag-latest-master-list';
    
    my $response = cached_get($url);
    foreach(split /\n/, $response)
    {
	unless (/\#.*/)
	{
	    (my $name, my $base, my $tag, my $dirs) = split / : /, $_;
	    return $name if $name =~ /$master/;
	}
    }
    return undef;
}

sub is_milestone($)
{
    my $name= shift;
    return 1 if ($name =~ /\w+(300)|(680)_m\d+/);
    return 0;
}

sub update_to($$$)
{
    my $config= shift;
    my $cws_list= shift;
    my $name= shift;
    my $cwd = &Cwd::cwd();
    my $cws_tag= $cws_list->{$name}->{'tag'};
    logger "updating to $cws_tag...";
    chdir 'workdir';
    foreach (@{$cws_list->{$name}->{'dirs'}})
    {
        run('cvs', "-d", $config->{'cvs_root'}, $config->{'cvs_options'}, 'co', "-Pr", "$cws_tag", "$_");
    }
    foreach (@{$cws_list->{$name}->{'newdirs'}})
    {
        run('cvs', "-d", $config->{'cvs_root'}, $config->{'cvs_options'}, 'co', "-Pr", "HEAD", "$_");
    }

    logger "done!";
    chdir $cwd;
}

sub ensure_workdir()
{
    my $px;
    logger "removing workdir if exists ...";
    rmtree 'workdir.old' if -d 'workdir.old';
    $px = system "mv workdir workdir.old" if -d 'workdir';
    die "" if $px;
    mkdir 'workdir';
    logger "done!";
}

sub untar_milestone($$)
{
    my $config= shift;
    my $milestone= shift;

    my $filename= $config->{'cache_dir'} . $milestone . ".tar.bz2";
    
    my $cwd = &Cwd::cwd();		
    die "can't find tarball!" unless -f $filename;
    chdir 'workdir';
    run('tar', 'xjf', $filename);
    chdir $cwd;
}

sub download_from_go_oo($$)
{
    my $config= shift;
    my $milestone= shift;
    (my $master, my $number)= split /_/, $milestone;
    my $base_url= "http://download.go-oo.org/$master/";
    my $base_file= lc $master . "-$number";
    my @files = ("artwork.tar.bz2", "base.tar.bz2", "bootstrap.tar.bz2", "calc.tar.bz2",
                 "components.tar.bz2", "filters.tar.bz2", "impress.tar.bz2", "l10n.tar.bz2",
                 "libs_core.tar.bz2", "libs_extern.tar.bz2", "libs_extern_sys.tar.bz2",
                 "libs_gui.tar.bz2", "postprocess.tar.bz2", "sdk.tar.bz2", "swext.tar.bz2",
                 "testing.tar.bz2", "ure.tar.bz2", "writer.tar.bz2");
    my $cwd = &Cwd::cwd();
    my $tempdir = tempdir ( $milestone . "-XXXX", DIR => $cwd, CLEANUP => 1);
    logger "trying to find $milestone tarballs at go-oo...";
    chdir($tempdir);
    foreach my $file (@files)
    {
	logger "getting $base_url$base_file-$file...";
	unless (is_success(getstore("$base_url$base_file-$file", $file)))
	{
	    chdir $cwd;
	    logger "failing";
	    return 0;
	}
	logger "done!";
    }
    logger "success!";
    foreach my $file (@files)
    {
	chdir $cwd;
	chdir 'workdir';
	logger "unpacking $file ...";
	run('tar', 'xjf', "$tempdir/$file");
	logger "done!";
    }
    my @dirs= glob "$base_file*/*";
    foreach my $dir (@dirs) { run("mv", $dir, ".") }
    rmtree "$base_file*";
    @dirs= glob '*';
    logger "packing $milestone for cache ...";
    run('tar', 'cjf', $config->{'cache_dir'} . "$milestone.tar.bz2", @dirs);
    logger "done!";
    chdir $cwd;
    return 1;
}

sub logger
{
    my $msg   = shift;
    my $level = shift || $log_level;
    
    if ($level <= $log_level)
    {
        if ($msg eq "done!" and ($level < $DEBUG_LOG_LEVEL))
        {
            print STDERR $msg . " (at " . time() . ")\n";
        }
        else
        {
            print STDERR "[" . time() . "] - " . $msg;
            print STDERR "\n" unless ($msg=~/.*\.\.\.$/ && $log_level < $DEBUG_LOG_LEVEL);
        }
    }
}

##################  Main

my $help_option;
my $branch= '';
GetOptions('help'        => \$help_option,
	   'branch:s'    => \$branch);

if ($help_option)
{
    print STDERR "Usage:\n";
    print STDERR "\t$0 [--branch=<branch>]\n";
    print STDERR "\twhere <branch> is a cws name or milestone name\n";
    print STDERR "Examples:\n";
    print STDERR "\"$0 --branch=DEV310_m12\"  get DEV310 milestone 12\n";
    print STDERR "\"$0 --branch=swwarnings\"  get swwarnings cws\n";
    print STDERR "\"$0 --branch=HEAD\"  get latest DEV310 milestone\n";
    print STDERR "\"$0\"  get latest DEV310 milestone\n\n\n";
    exit 1;
}

my @ar=();
my $arrayref = \@ar;
my %defaults= ( 
		'cache_size' => 4,
		'cvs_root' => ':pserver:anoncvs@anoncvs.services.openoffice.org:/cvs',
		'cvs_options' => "-z6",
		'log_level' => $NORMAL_LOG_LEVEL,
		'cache_dir' => &Cwd::cwd() . '/tarballs/',
		'brokenlist' => $arrayref
		);
logger "$0 started";
my $config= Config::Auto::parse("$0.config", format => 'equal');
my $cws_list= grab_tag_list;
merge_defaults(\%defaults, $config);
$log_level= $config->{'log_level'};
logger "config_values: " . Dumper($config), $DEBUG_LOG_LEVEL;
ensure_cache_dir($config);
(my $milestone, my $cws)= interpret_branch($branch, $cws_list);

logger "milestone= $milestone";
logger "cws= $cws";

logger "modules= ".join( " ", @{$cws_list->{$cws}->{'dirs'}}) if $cws ne "none";
logger "new modules= ".join( " ", @{$cws_list->{$cws}->{'newdirs'}}) if $cws ne "none";

# Read the list with broken milestones from config
my @brokenlist = @{$config->{'brokenlist'}};

foreach my $known_broken (@brokenlist) 
{
	logger "used $milestone - check $known_broken";
	if ("$milestone" =~ "$known_broken") {
		logger "Build rejected!";
		logger "This build is based on milestone $milestone - This milestone is known to be broken or not supported by this buildbot";
		logger "Please resync!";
		exit 65;
	}
}

ensure_workdir();

my $vcs= "cvs";      #default for now
#$vcs= "svn" if ( $milestone =~ "(DEV300_m999)|(DEV310.*)" );

if (milestone_in_cache($config, $milestone))
{
    cache_touch($config, $milestone);
    untar_milestone($config, $milestone);
}
else
{
    cache_evict($config);
    unless (download_from_go_oo($config, $milestone))
    {
	cache_add_from_checkout($config, $milestone, $vcs);
    } 
}

my $milestonenr = $milestone;
my $workstamp = $milestone;
$milestonenr =~ s/.*_m//;
$workstamp =~ s/_m.*//;
open(MILESTONEFILE, ">workdir/milestone") or die "can't write milestone file\n";
print MILESTONEFILE "fetched_milestone=$milestonenr\nexport fetched_milestone\n";
print MILESTONEFILE "fetched_workstamp=$workstamp\nexport fetched_workstamp\n";
close MILESTONEFILE;

if ( !opendir(DIR, "workdir/scext") ) 
{
    logger "trying to checkout module scext for $milestone";
    my $cwd = &Cwd::cwd();
    chdir("workdir");
    my @cmd_ = ('cvs', '-d', $config->{'cvs_root'},
                 $config->{'cvs_options'}, 'co', '-r', $milestone, 'scext');
    logger "system(\"" . join ('", "', @cmd_) . "\");\n", $DEBUG_LOG_LEVEL;
    logger "can't run $cmd_[0]!!\n" unless !system(@cmd_);
    chdir $cwd;
}
else
{
    closedir( DIR )
}
update_to($config, $cws_list, $cws) if $cws ne "none";
logger "finished"
